home *** CD-ROM | disk | FTP | other *** search
/ Die Speccy' 97 / Die Speccy' 97.iso / amiga_system / the_aminet / comm / bbs / bbbbs85.lha / rexx / bbsEd.rexx < prev    next >
OS/2 REXX Batch file  |  1995-01-21  |  23KB  |  946 lines
  1. /* $VER: bbsEd.rexx 8.4 (21.1.95)
  2. copyright ⌐ 1994-95 Richard Lee Stockton
  3. BBBBS text editor
  4. FREELY DISTRIBUTABLE
  5. */
  6.  
  7. IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
  8. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  9.  
  10. OPTIONS RESULTS
  11. SIGNAL ON BREAK_C
  12. SIGNAL ON BREAK_E
  13. SIGNAL ON FAILURE
  14. SIGNAL ON SYNTAX
  15.  
  16. PARSE ARG firstedit editarg name maxtime .
  17. IF ~DATATYPE(maxtime,'N') THEN maxtime=3000
  18.  
  19. CALL TIME('R')
  20. namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
  21.  
  22. def=''
  23. pen2=''
  24. pen3=''
  25. bak2=''
  26. IF colorflag=0 THEN
  27.   DO
  28.     def=''
  29.     pen2=''
  30.     pen3=''
  31.     bak2=''
  32.   END
  33. lineup='1B'x'M'
  34. CR=''
  35. IF ADDRESS()='BAUD' THEN
  36.   DO
  37.     CR='0D'x
  38.     frombb=1
  39.   END
  40. ELSE frombb=0
  41.  
  42. SAY '                  'lineup||CR
  43. SAY '                   'pen3'Entering the EDITOR module..'def||CR
  44. SAY CR
  45. CALL config()
  46. CALL loaddata()
  47. pasted.=''
  48. pasted.0=0
  49. notchanged=1
  50. IF readlines(editarg 1) THEN EXIT 1
  51. IF OPEN(f,scratch'/edclip','R')~=0 THEN
  52.   DO
  53.     DO i=1
  54.       line=READLN(f)
  55.       IF EOF(f) THEN LEAVE i
  56.       pasted.i=line
  57.     END
  58.     CALL CLOSE(f)
  59.     pasted.0=i-1
  60.   END
  61. finfo=STATEF(editarg)
  62. IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
  63. ELSE finfo=''
  64. count=1
  65. DO edloop=1
  66.   IF edcom='S' & bbsprefs.5 THEN  /* spell check */
  67.     DO
  68.       SAY pen3'You must use ['def'R'pen3']eplace to make corrections.  'pen2'Spellchecking...'def||CR
  69.       CALL DELETE(scratch'/SpellFile')
  70.       CALL savelines(scratch'/SpellFile')
  71.       curdir=PRAGMA('D')
  72.       CALL setdir(spellpath)
  73.       CALL SpellChk.rexx(scratch'/SpellFile')
  74.       CALL setdir(curdir)
  75.     END
  76.   ELSE
  77.     DO
  78.       IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7)
  79.       IF edcom~='L' THEN count=count-linesperpage
  80.       IF count>=lynes.0 | count<1 THEN count=1
  81.       startcount=count
  82.       DO i=startcount TO lynes.0+1
  83.         IF ((i+1-startcount)//linesperpage)=0 & i<lynes.0 THEN
  84.           DO
  85.             pline='                 ['pen3'E'def']dit'
  86.             pline=pline '  ['pen3'RETURN'def']=Continue '
  87.             edcom=getinput(1 1 pline)
  88.             IF edcom~='' THEN LEAVE i
  89.             CALL cleanline(1)
  90.           END
  91.         SAY pen3||RIGHT(i,3)||def lynes.i||CR
  92.         count=count+1
  93.       END
  94.     END
  95.   CALL checktime()
  96.   SAY lineup'     ['pen3'A'def']ppend ['pen3'C'def']ut     ['pen3'I'def']nsert  ['pen3'K'def']ill       ['pen3'?'def'] Help'CR
  97.   pline='     ['pen3'L'def']ist   ['pen3'P'def']aste   ['pen3'R'def']eplace'
  98.   IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck'
  99.   pline=pline '['pen3'U'def']pload-Text > '
  100.   edcom=getinput(1 0 pline)
  101.   IF edcom='Q' | edcom='X' THEN edcom=''
  102.   IF edcom='?' THEN
  103.     DO
  104.       SAY CR
  105.       SAY '                   Editor Help'CR
  106.       SAY '----------------------------------------------------------'CR
  107.       SAY '    an empty RETURN tells the editor you are done editing.'CR
  108.       SAY ' 7  edits line number 7, if it exists.'CR
  109.       SAY ' a  Append text to this file.'CR
  110.       SAY ' c  Cut selected line(s) of text to buffer.'CR
  111.       SAY ' i  Insert blank line.'CR
  112.       SAY ' k  Kill (delete) this file.'CR
  113.       SAY ' l  List this file from selected line.'CR
  114.       SAY ' p  Paste buffer contents to selected line number.'CR
  115.       SAY ' r  Replace a phrase or line of text.'CR
  116.       SAY ' s  Spellcheck this file.'CR
  117.       SAY ' u  Upload a textfile to append to this file.'CR
  118.       SAY '----------------------------------------------------------'CR
  119.       SAY CR
  120.       OPTIONS PROMPT ''
  121.       PULL
  122.     END
  123.   IF edcom='K' THEN
  124.     DO
  125.       junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ')
  126.       IF junk='Y' THEN
  127.         DO
  128.           IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'CR
  129.           IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
  130.             DO
  131.               IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN
  132.                 SAY WORD(lynes.2,4) 'DELETED.'CR
  133.             END
  134.           EXIT 2
  135.         END
  136.     END
  137.   IF edcom='' THEN
  138.     DO
  139.       SAY '                   'pen3'Leaving the EDITOR module.'def||CR
  140.       IF pasted.0>0 THEN
  141.         IF OPEN(f,scratch'/edclip','W')~=0 THEN
  142.           DO
  143.             IF pasted.0>99 THEN pasted.0=99
  144.             DO i=1 TO pasted.0
  145.               CALL WRITELN(f,pasted.i)
  146.             END
  147.             CALL CLOSE(f)
  148.           END
  149.       IF notchanged THEN EXIT 0
  150.       IF getinput(1 1 '                     Save changes? (nY)'pen3' > 'def)='N' THEN
  151.         EXIT 1
  152.       CALL DELETE(editarg)
  153.       IF savelines(editarg) THEN EXIT 1
  154.       CALL DELAY(28)
  155.       IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo
  156.       SAY pen3'                        Changes saved.'def||CR
  157.       EXIT 0
  158.     END
  159.   ELSE IF edcom='C' THEN  /* Cut */
  160.     DO
  161.       firstnum=getinput(1 0 '   Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def)
  162.       IF firstnum='' THEN ITERATE edloop
  163.       dash=POS('-',firstnum)
  164.       IF dash>0 THEN
  165.         DO
  166.           lastnum=STRIP(SUBSTR(firstnum,dash+1))
  167.           firstnum=STRIP(LEFT(firstnum,dash-1))
  168.         END
  169.       ELSE lastnum=firstnum
  170.       IF ~DATATYPE(firstnum,'W') | ~DATATYPE(lastnum,'W') THEN
  171.         DO
  172.           junk=getinput(1 1 pen3'*** You must enter numbers here! 'def)
  173.           ITERATE edloop
  174.         END
  175.       IF lastnum>lynes.0 THEN lastnum=lynes.0
  176.       IF firstnum<firstedit THEN
  177.         DO
  178.           SAY '*** You are not authorized to delete that line!'CR
  179.           SAY CR
  180.           ITERATE edloop
  181.         END
  182.       IF firstnum>lastnum THEN
  183.         DO
  184.           SAY '*** Input error!  First number larger than last number.'CR
  185.           ITERATE edloop
  186.         END
  187.       notchanged=0
  188.       numdiff=lastnum+1-firstnum
  189.       pasted.=''
  190.       pasted.0=numdiff
  191.       k=0
  192.       DO i=firstnum TO lynes.0
  193.         j=i+numdiff
  194.         k=k+1
  195.         IF k<=numdiff THEN pasted.k=lynes.i
  196.         lynes.i=lynes.j
  197.         lynes.j=''
  198.       END
  199.       lynes.0=lynes.0-numdiff
  200.       count=1
  201.     END
  202.   ELSE IF edcom='A' THEN  /* append */
  203.     DO
  204.       IF frombb THEN temp='File'
  205.       ELSE temp='LOCAL'
  206.       CALL writebuffer(scratch'/Editor'temp)
  207.       notchanged=0
  208.     END
  209.   ELSE IF edcom='U' THEN  /* Upload a textfile to append */
  210.     DO
  211.       CALL txup(editarg)
  212.       notchanged=0
  213.     END
  214.   ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'W') THEN
  215.     DO
  216.       IF DATATYPE(edcom,'W') THEN
  217.         DO
  218.           ednum=edcom
  219.           edcom='R'
  220.         END
  221.       ELSE
  222.         DO
  223.           line=pen3'   '
  224.           IF edcom='L' | edcom='P' THEN line=line'Starting '
  225.           line=line'Line Number? > 'def
  226.           ednum=getinput(1 0 line)
  227.         END
  228.       IF ~DATATYPE(ednum,'W') THEN ITERATE edloop
  229.       IF ednum>(lynes.0+1) THEN ITERATE edloop
  230.       IF edcom='L' THEN
  231.         DO
  232.           count=ednum
  233.           ITERATE edloop
  234.         END
  235.       IF ednum=1 & UPPER(WORD(lynes.1,1))='FILE:' THEN
  236.         DO
  237.           IF getinput(1 1 pen3'Edit KeyWords:? (Ny) > 'def)='Y' THEN
  238.             DO
  239.               filenum=STRIP(WORD(lynes.1,2))
  240.               keywords=edkeywords(editarg)
  241.               lynes.1=LEFT(lynes.1,21) keywords
  242.               suf='LOCAL'
  243.               IF frombb THEN suf=''
  244.               t=GETCLIP('BBS_FileChange'suf)
  245.               CALL SETCLIP('BBS_FileChange'suf,STRIP(t filenum))
  246.               CALL SETCLIP('BBS_Keywords_'filenum,keywords)
  247.               notchanged=0
  248.               ITERATE edloop
  249.             END
  250.         END
  251.       IF ednum<firstedit THEN
  252.         DO
  253.           SAY '*** You are not authorized to alter that line!'CR
  254.           SAY CR
  255.           ITERATE edloop
  256.         END
  257.       IF edcom='R' THEN   /* replace */
  258.         DO
  259.           SAY '   Now reads:'CR
  260.           SAY pen3||RIGHT(ednum,2)||def lynes.ednum||CR
  261.           OPTIONS PROMPT pen3'........Search text? >'def
  262.           PARSE PULL stext
  263.           IF LENGTH(stext)=0 THEN
  264.             DO
  265.               IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
  266.                 ITERATE edloop
  267.               lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def)
  268.               notchanged=0
  269.               ITERATE edloop
  270.             END
  271.           found=POS(UPPER(stext),UPPER(lynes.ednum))
  272.           IF found=0 THEN
  273.             DO
  274.               SAY CR
  275.               SAY stext' was not found!'CR
  276.               SAY CR
  277.               ITERATE edloop
  278.             END
  279.           OPTIONS PROMPT pen3'...Replacement text? >'def
  280.           PARSE PULL rtext
  281.           lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
  282.           lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
  283.           IF ednum<4 & LEFT(lynes.1,6)='File: ' THEN
  284.             DO
  285.               PARSE VAR lynes.1 'File: 'filenum . 'KeyWords: 'keywords
  286.               PARSE VAR lynes.3 . 'Lib:' libnam
  287.               filenum=STRIP(filenum)
  288.               newc=files.filenum.0
  289.               libnum=finddirnum(libnam)
  290.               alpha.newc=LEFT(WORD(lynes.2,2),22-LENGTH(WORD(lynes.2,4)))
  291.               alpha.newc=alpha.newc WORD(lynes.2,4) RIGHT(filenum,5)
  292.               alpha.newc=alpha.newc RIGHT(libnum,2) LEFT(STRIP(libnam),12)
  293.               alpha.newc=alpha.newc STRIP(LEFT(STRIP(keywords),32))
  294.               savefileflag=1
  295.             END
  296.           SAY 'Done.'CR
  297.           SAY CR
  298.           notchanged=0
  299.         END
  300.       ELSE IF edcom='I' THEN  /* insert */
  301.         DO
  302.           DO i=lynes.0 TO ednum BY -1
  303.             j=i+1
  304.             lynes.j=lynes.i
  305.           END
  306.           lynes.ednum=''
  307.           notchanged=0
  308.           lynes.0=lynes.0+1
  309.           OPTIONS PROMPT pen3||RIGHT(ednum,2)'>'def
  310.           PARSE PULL lynes.ednum
  311.         END
  312.       ELSE IF edcom='P' THEN   /* paste */
  313.         DO
  314.           DO i=lynes.0 TO ednum BY -1
  315.             j=i+pasted.0
  316.             lynes.j=lynes.i
  317.           END
  318.           DO k=1 TO pasted.0
  319.             kk=ednum+k-1
  320.             lynes.kk=pasted.k
  321.           END
  322.           notchanged=0
  323.           lynes.0=lynes.0+pasted.0
  324.         END
  325.     END
  326. END
  327. EXIT 0
  328.  
  329.  
  330. writebuffer:
  331. PARSE ARG bufname .
  332. IF frombb THEN Capture OFF
  333. CALL DELETE(bufname)
  334. startnum=lynes.0+1
  335. SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR
  336. IF EXISTS(bufname) THEN
  337.   DO
  338.     CALL DELAY(56)
  339.     CALL DELETE(bufname)
  340.     CALL DELAY(56)
  341.   END
  342. IF frombb THEN
  343.   DO
  344.     CaptWrap 74
  345.     Send pen3
  346.     Capture bufname
  347.     Send def
  348.     TimeOut 120
  349.     DO bufloop=1
  350.       Wait '/E,/S,RING,NO CARRIER'
  351.       Status 'L'
  352.       test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
  353.       CALL checkdcd()
  354.       IF test='/E' | test='/S' | test='/X' THEN LEAVE bufloop
  355.     END
  356.     IF test~='/X' THEN Send '\b\b'pen3
  357.     Capture OFF
  358.     CALL checkdcd()
  359.     TimeOut maxidle
  360.     SAY def||CR
  361.     CALL readlines(bufname startnum)
  362.     CALL wrapbuf(startnum)
  363.     QUEUE CR
  364.   END
  365. ELSE
  366.   DO
  367.     OPTIONS PROMPT ''
  368.     DO bufloop=startnum
  369.       PARSE PULL line
  370.       IF LEFT(UPPER(STRIP(line)),2)='/E' | LEFT(UPPER(STRIP(line)),2)='/S' THEN
  371.         LEAVE bufloop
  372.       lynes.bufloop=line
  373.     END
  374.     lynes.0=bufloop-1
  375.     CALL wrapbuf(startnum)
  376.     CALL DELETE(bufname)
  377.     CALL savelines(bufname)
  378.     SAY
  379.   END
  380. RETURN
  381.  
  382.  
  383. wrapbuf:
  384. ARG startnum .
  385. CALL cleanline(1)
  386. SAY pen3'Wordwrapping...'def||CR
  387. lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
  388. lynes.startnum=cleanstring(2':'lynes.startnum)
  389. DO wi=startnum WHILE wi<=lynes.0
  390.   wj=wi+1
  391.   lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
  392.   lynes.wj=cleanstring(2':'lynes.wj)
  393.   IF LENGTH(lynes.wi)>75 THEN
  394.     DO
  395.       testchar=''
  396.       IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
  397.       IF testchar=' ' | testchar='.' | testchar=':' THEN
  398.         DO
  399.           DO wjj=lynes.0 TO wi+1 BY -1
  400.             wk=wjj+1
  401.             lynes.wk=lynes.wjj
  402.           END
  403.           lynes.wj=''
  404.           lynes.0=lynes.0+1
  405.         END
  406.       DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
  407.         IF WORDS(lynes.wi)=1 THEN
  408.           lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
  409.         lynes.wj=WORD(lynes.wi,wl) lynes.wj
  410.         lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
  411.       END
  412.     END
  413. END
  414. RETURN
  415.  
  416.  
  417. txup:
  418. PARSE ARG uparg .
  419. IF frombb THEN
  420.   DO
  421.     SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR
  422.     pline='Are you SURE your file is un-compressed text? (Ny) > '
  423.     IF getinput(1 1 pline)~='Y' THEN RETURN
  424.   END
  425. savearg=arg
  426. arg='Upload'
  427. arg2='tempfile1'
  428. IF frombb THEN arg=arg'File'
  429. ELSE
  430.   DO
  431.     arg=arg'LOCAL'
  432.     arg2=arg2'LOCAL'
  433.   END
  434. curdir=PRAGMA('D')
  435. CALL setdir(scratch)
  436. CALL DELETE(arg)
  437. CALL DELETE(arg2)
  438. IF uload()=0 THEN
  439.   DO
  440.     ADDRESS COMMAND 'C:copy' uparg scratch'/'arg2 'CLONE'
  441.     CALL DELETE(uparg)
  442.     ADDRESS COMMAND 'C:join' scratch'/'arg2 PRAGMA('D')'/'arg 'AS' uparg
  443.   END
  444. CALL readlines(uparg 1)
  445. notchanged=0
  446. CALL setdir(curdir)
  447. arg=savearg
  448. RETURN
  449.  
  450.  
  451. chpro:
  452. arg=UPPER(LEFT(arg,1))
  453. IF(arg='') THEN
  454.   DO
  455.     SAY CR
  456.     SAY '['pen3'W'def']- WXModem'CR
  457.     SAY '['pen3'X'def']- XModem-CRC'CR
  458.     SAY '['pen3'K'def']- XModem-1K'CR
  459.     SAY '['pen3'Y'def']- YModem'CR
  460.     SAY '['pen3'G'def']- YModem-G'CR
  461.     SAY '['pen3'Z'def']- ZModem'CR
  462.     SAY CR
  463.     arg=getinput(1 0 STRIP(protocol) '> ')
  464.  END
  465. IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
  466. Set arg
  467. Status Transfer
  468. protocol=STRIP(RESULT)
  469. SAY protocol||CR
  470. RETURN
  471.  
  472.  
  473. uload:
  474. CALL bbsspace(12)
  475. SAY CR
  476. IF bbsk<1 THEN
  477.   DO
  478.     line='Upload area is full!'
  479.     CALL send2log(line)
  480.     SAY pen3||line||def||CR
  481.     RETURN 1
  482.   END
  483. IF frombb THEN
  484.   DO
  485.     checkproto='T'
  486.     targ=arg
  487.     DO WHILE checkproto='T'
  488.       arg=''
  489.       SAY CR
  490.       SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def'  Protocol:'pen3 protocol||def||CR
  491.       pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
  492.       pline=pline '['pen3'U'def']pload (qtU) > '
  493.       checkproto=getinput(1 1 pline)
  494.       IF checkproto='Q' THEN RETURN 1
  495.       IF checkproto='T' THEN CALL chpro()
  496.     END
  497.     arg=targ
  498.     IF bbsprefs.13~=1 THEN ADDRESS AREXX bbsSounds.rexx bbspath'/Sounds' 'UPLOAD'
  499.     uploadtime=TIME('E')
  500.     CALL checktime()
  501.     SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
  502.     DownLoad arg
  503.     IF RC>0 THEN RETURN 2
  504.     IF bbsXferStats.baud(14 arg colorflag protocol) THEN RETURN 2
  505.     rbytes=WORD(STATEF(arg),2)
  506.     IF rbytes<1 THEN
  507.       DO
  508.         CALL DELETE(arg)
  509.         RETURN 2
  510.       END
  511.     temp=''
  512.     DO WHILE temp~='N' & temp~='Y'
  513.       temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ')
  514.     END
  515.     IF temp='N' THEN RETURN 2
  516.   END
  517. ELSE
  518.   DO
  519.     frompath=GETCLIP('BBS_frompath')
  520.     IF frompath='' THEN frompath='RAM:'
  521.     fdir=''
  522.     DO loop=1
  523.       fromfile=GetFile(150,36,frompath,'',' Select File to Upload ')
  524.       IF fromfile='' THEN RETURN 1
  525.       IF EXISTS(fromfile) THEN LEAVE loop
  526.       SAY
  527.       SAY fromfile 'does not exist!'
  528.     END
  529.     ADDRESS COMMAND 'C:COPY' fromfile PRAGMA('D') 'CLONE'
  530.     rbytes=WORD(STATEF(fromfile),2)
  531.     x=LASTPOS('/',fromfile)
  532.     IF x=0 THEN x=POS(':',fromfile)
  533.     IF x>0 THEN
  534.       DO
  535.         arg=SUBSTR(fromfile,x+1)
  536.         fdir=LEFT(fromfile,x)
  537.         IF RIGHT(fdir,1)='/' THEN fdir=LEFT(fdir,x-1)
  538.         CALL SETCLIP('BBS_frompath',fdir)
  539.       END
  540.     ELSE arg=fromfile
  541.   END
  542. IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  543.   DO
  544.     SAY CR
  545.     SAY pen3'***'def arg pen3'failed archive check!'def||CR
  546.     SAY CR
  547.     temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
  548.     IF temp~='Y' THEN
  549.       DO
  550.         CALL DELETE(arg)
  551.         SAY CR
  552.         RETURN 2
  553.       END
  554.   END
  555. IF ~frombb THEN RETURN 0
  556. CALL bytes2user(14 rbytes)
  557. ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
  558. IF bbsprefs.9 & name~=sysop THEN
  559.   DO
  560.     newufile=bbspath'EMail/'sysop'/NEW_FILES'
  561.     IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
  562.     ELSE
  563.       DO
  564.         ok=OPEN(f,newufile,'W')
  565.         IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***') 
  566.       END
  567.     IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
  568.     CALL CLOSE(f)
  569.   END
  570. RETURN 0
  571.  
  572.  
  573. bytes2user:
  574. PARSE ARG indx bytes .
  575. tfiles=WORD(data.indx,1)
  576. tbytes=WORD(data.indx,3)
  577. IF ~DATATYPE(tfiles,'W') THEN tfiles=0
  578. IF ~DATATYPE(tbytes,'W') THEN tbytes=0
  579. tbytes=tbytes+bytes
  580. tfiles=tfiles+1
  581. IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
  582. ELSE data.indx='1 file' bytes 'bytes.'
  583. data.indx=data.indx DATE()
  584. CALL savedata(0)
  585. RETURN
  586.  
  587.  
  588. bbsspace:
  589. ARG tabspace .
  590. ADDRESS COMMAND 'C:info >'scratch'/infout' bbsdevice
  591. ok=OPEN(f,scratch'/infout','R')
  592. IF ok=0 THEN RETURN 20
  593. line=READLN(f)
  594. line=READLN(f)
  595. line=READLN(f)
  596. line=READLN(f)
  597. CALL CLOSE(f)
  598. IF tabspace<14 THEN SAY CR
  599. bbsk=WORD(line,4)
  600. IF ~DATATYPE(bbsk,'N') THEN
  601.   DO
  602.     line=bbsdevice 'is not an info compatible device!'
  603.     CALL send2log(line)
  604.     SAY pen3||line||def||CR
  605.     bbsk=0
  606.     RETURN
  607.   END
  608. bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
  609. IF bbsk<1 THEN bbsk=0
  610. SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
  611. RETURN
  612.  
  613.  
  614. comma:
  615. ARG num .
  616. t=''
  617. x=POS('.',num)
  618. IF x>0 THEN t=SUBSTR(num,x)
  619. num=num%1
  620. dgt=LENGTH(num)
  621. numtext=''
  622. IF dgt>3 THEN numtext=','RIGHT(num,3)
  623. IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
  624. IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
  625. IF dgt>12 THEN
  626.   DO
  627.     numtext=','LEFT(RIGHT(num,12),3)||numtext
  628.     numtext=LEFT(num,dgt-12)||numtext
  629.   END
  630. ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
  631. ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
  632. ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
  633. ELSE numtext=num
  634. RETURN numtext||t
  635.  
  636.  
  637. loaddata:
  638. IF name='' THEN RETURN 0
  639. IF OPEN(f,bbspath'USERS/'name,'R')=0 THEN RETURN 0
  640. data.=''
  641. DO i=1
  642.   line=READLN(f)
  643.   IF EOF(f) THEN BREAK
  644.   data.i=line
  645. END
  646. data.0=i-1
  647. CALL CLOSE(f)
  648. protocol=data.6
  649. IF ~DATATYPE(data.7,'W') | data.7<5 | ~frombb THEN data.7=20
  650. linesperpage=data.7
  651. IF ~frombb THEN linesperpage=20
  652. IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
  653. ELSE colorflag=0
  654. level=data.20
  655. RETURN 1
  656.  
  657.  
  658. savedata:
  659. IF OPEN(f,bbspath'USERS/'name,'W')=0 THEN RETURN
  660. IF data.0<27 THEN data.0=27
  661. DO i=1 TO data.0
  662.   CALL WRITELN(f,data.i)
  663. END
  664. CALL CLOSE(f)
  665. SAY 'User' name 'has been updated.'CR
  666. IF frombb THEN CALL SETCLIP('BBS_interpret','CALL loaddata()')
  667. RETURN
  668.  
  669.  
  670. edkeywords:
  671. PARSE ARG kwarg
  672. templine=''
  673. DO WHILE LENGTH(templine)<3
  674.   SAY CR
  675.   SAY pen3'Please enter a list of keywords (or a condensed description)'def||CR
  676.   SAY pen3'to be used in the alphabetic list and by the search routine.'def||CR
  677.   SAY '    Note that only the first 32 characters will be used.'CR
  678.   SAY LEFT('',43)'|'LEFT('',31,'=')'|'CR
  679.   templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
  680.   templine=cleanstring('0:'templine)
  681.   templine=STRIP(LEFT(templine,32))
  682.   SAY CR
  683. END
  684. RETURN templine
  685.  
  686.  
  687. readlines:
  688. CALL CLOSE(f)
  689. PARSE ARG tempname readstart .
  690. IF OPEN(f,tempname,'R')=0 THEN RETURN 1
  691. IF readstart<2 THEN lynes.=''
  692. DO ri=readstart
  693.   line=READLN(f)
  694.   IF EOF(f) THEN BREAK
  695.   lynes.ri=line
  696. END
  697. lynes.0=ri-1
  698. CALL CLOSE(f)
  699. DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
  700. END
  701. lynes.0=ri
  702. RETURN 0
  703.  
  704.  
  705. savelines:
  706. PARSE ARG tempname .
  707. IF OPEN(f,tempname,'W')=0 THEN
  708.   DO
  709.     line='***' tempname 'failed to open for saving!'
  710.     CALL send2log(line)
  711.     SAY line||CR
  712.     RETURN 1
  713.   END
  714. DO wi=1 TO lynes.0
  715.   CALL WRITELN(f,lynes.wi)
  716. END
  717. CALL CLOSE(f)
  718. RETURN 0
  719.  
  720.  
  721. setdir:
  722. PARSE ARG tempdir
  723. CALL PRAGMA('D',STRIP(tempdir))
  724. directory=PRAGMA('D')
  725. IF frombb THEN Data directory
  726. slash=LASTPOS('/',directory)
  727. IF slash=0 THEN slash=LASTPOS(':',directory)
  728. plaindir=directory
  729. IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
  730. RETURN
  731.  
  732.  
  733. config:
  734. arg='s:CONFIG.BBS'
  735. IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
  736. IF readlines(arg 1) THEN
  737.   DO
  738.     SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
  739.     EXIT 666
  740.   END
  741. bbsdevice=WORD(lynes.4,1)
  742. sysoplevel=WORD(lynes.5,1)
  743. bbspath=WORD(lynes.6,1)
  744. IF ~EXISTS(bbspath) THEN
  745.   DO
  746.     SAY bbspath 'does not exist!'CR
  747.     EXIT 666
  748.   END
  749. testchar=RIGHT(bbspath,1)
  750. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  751. SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
  752. bbsprefs.=''
  753. DO i=16 TO 41
  754.   j=i-15
  755.   bbsprefs.j=STRIP(WORD(lynes.i,1))
  756. END
  757. spellpath=WORD(lynes.9,1)
  758. IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  759.   DO
  760.     SAY spellpath 'does not exist!'CR
  761.     bbsprefs.5=0
  762.   END
  763. IF bbsprefs.10 THEN scratch=bbspath'Scratch'
  764. ELSE scratch='RAM:Scratch'
  765. CALL MAKEDIR(scratch)
  766. RETURN
  767.  
  768.  
  769. finddirnum:
  770. ARG fdirname .
  771. IF ~DATATYPE(dirs.0,'W') THEN CALL loaddirs()
  772. DO fdir=1 TO 99
  773.   IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
  774. END
  775. RETURN 100
  776.  
  777.  
  778. loaddirs:
  779. dirs.=''
  780. IF readopen(bbspath'Lists/Libraries')=0 THEN EXIT
  781. SAY 'Loading library list...'CR
  782. DO i=1
  783.   line=READLN(f)
  784.   IF line='END' | EOF(f) THEN LEAVE i
  785.   num=WORD(line,1)
  786.   IF DATATYPE(num,'W') THEN
  787.     DO
  788.       IF num>level THEN ITERATE i
  789.       dirs.num=STRIP(WORD(line,2))
  790.     END
  791. END
  792. CALL CLOSE(f)
  793. CALL sortlibraries()
  794. RETURN
  795.  
  796.  
  797. send2log:
  798. PARSE ARG sendline
  799. logfile=bbspath'Logs/log.'DATE('S')
  800. IF ~OPEN('log',logfile,'A') THEN
  801.   DO
  802.     IF ~OPEN('log',logfile,'W') THEN
  803.       DO
  804.         SAY 'failed to open log file'
  805.         RETURN
  806.      END
  807.   END
  808. CALL WRITELN('log','bbsEd:' sendline)
  809. CALL CLOSE('log')
  810. RETURN
  811.  
  812.  
  813. checktime:
  814. IF ~frombb THEN RETURN
  815. IF TIME('E')>maxtime THEN EXIT 0
  816. IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
  817. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  818. CALL checkdcd()
  819. RETURN
  820.  
  821.  
  822. cleanline:
  823. ARG lflag .
  824. IF nonstop=0 & clr~='' THEN
  825.   DO
  826.     Send clr
  827.     RETURN
  828.   END
  829. IF colorflag~=1 & lflag=1 THEN RETURN
  830. cline=lineup||LEFT(' ',78)
  831. IF lflag=1 THEN cline=cline||lineup
  832. SAY cline||CR
  833. RETURN
  834.  
  835.  
  836. getinput:
  837. PARSE ARG upflag' 'oneflag' 'pline
  838. CALL checkdcd()
  839. OPTIONS PROMPT pline
  840. PARSE PULL inarg
  841. inarg=STRIP(inarg)
  842. IF upflag THEN inarg=UPPER(inarg)
  843. IF oneflag THEN inarg=LEFT(inarg,1)
  844. inarg=cleanstring(0':'inarg)
  845. RETURN inarg
  846.  
  847.  
  848. strip_ansi:
  849. PARSE ARG aline 
  850. n=POS('1B'x,aline)
  851. DO WHILE n>0
  852.   DO k=2
  853.     IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
  854.       leave k
  855.   END
  856.   aline=DELSTR(aline,n,k+1)
  857.   n=POS('1B'x,aline)
  858. END
  859. RETURN aline
  860.  
  861.  
  862. cleanstring:
  863. PARSE ARG nflag':'cstr
  864. IF nflag=1 THEN
  865.   DO
  866.     cstr=COMPRESS(cstr,"'`")
  867.     cstr=TRANSLATE(cstr,,namemask)
  868.     cstr=SPACE(cstr,1,'_')
  869.     RETURN cstr
  870.   END
  871. bot=XRANGE(,'1F'x)
  872. IF nflag=2 THEN bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
  873. ELSE cstr=strip_ansi(cstr)
  874. top=XRANGE('7F'x)
  875. cstr=COMPRESS(cstr,bot||top)
  876. IF nflag=0 THEN cstr=STRIP(cstr)
  877. RETURN cstr
  878.  
  879.  
  880. checkdcd:
  881. IF ~frombb THEN RETURN
  882. dcd
  883. IF RC=0 THEN
  884.   DO
  885.     DO dcds=1 TO 3  /* 5 second delay */
  886.       CALL DELAY(50)
  887.       dcd
  888.       IF RC~=0 THEN RETURN
  889.     END
  890.     dcd
  891.     IF RC=0 THEN EXIT 0
  892.   END
  893. xmsg=GETCLIP('BBS_MESSAGE')
  894. Capture
  895. IF RC=0 & xmsg~='' THEN
  896.   DO
  897.     CALL SETCLIP('BBS_MESSAGE')
  898.     SAY CR
  899.     SAY bak2' Message From BBBBS: 'def||CR
  900.     SAY xmsg||CR
  901.     SAY CR
  902.     CALL waiting()
  903.   END
  904. IF POS('G',GETCLIP('BBS_COMMAND'))>0 THEN EXIT 0
  905. RETURN
  906.  
  907.  
  908. waiting:
  909. CALL checktime()
  910. IF waitchar='Q' THEN
  911.   DO
  912.     waitchar=''
  913.     RETURN
  914.   END
  915. waitchar=''
  916. IF nonstop=1 THEN RETURN
  917. OPTIONS PROMPT pen3'                       RETURN=Continue  'def
  918. PULL waitchar
  919. RETURN
  920.  
  921.  
  922. BREAK_E:
  923. i=999999
  924. ri=999999
  925. wi=999999
  926. RETURN
  927.  
  928.  
  929. BREAK_C:
  930. EXIT 2
  931.  
  932.  
  933. FAILURE:
  934. SYNTAX:
  935. lin.1=''ERRORTEXT(RC)''
  936. lin.2=SIGL-1     SOURCELINE(SIGL-1)
  937. lin.3=SIGL ''SOURCELINE(SIGL)''
  938. lin.4=SIGL+1     SOURCELINE(SIGL+1)
  939. DO er=1 TO 4
  940.   IF level>sysoplevel | ~frombb THEN SAY 'bbsEd:' lin.er||CR
  941.   IF frombb THEN CALL send2log(lin.er)
  942. END
  943. EXIT 2
  944.  
  945. /* bbsEd.rexx */
  946.